#!/usr/bin/perl
use strict;
use utf8;

binmode(STDOUT, ':utf8');
binmode(STDERR, ':utf8');

use Geo::Parse::OSM;
use Data::Dump qw/dump/;

my %rel = ();
my %ways = ();
my %name2wayid = ();
my %wayid2relid = ();
my %relid2wayid = ();
my %relnames = ();
my @tags_to_match = qw/name/;
my %tags_to_match;
$tags_to_match{$_} = 0 for(@tags_to_match);

if (!-f $ARGV[0]) {
    print STDERR "<$ARGV[0]> is not a file; Usage: analyze.pl file.osm\n";
    exit;
}

my $osm = Geo::Parse::OSM->new($ARGV[0]);
$osm->parse(\&prepare_relations, only=>'relation');
$osm->seek_to_nodes;
$osm->parse(\&prepare_ways, only=>'way');
print "<html>\n<head><meta http-equiv='content' content='text/html;charset=utf8'/><title>Street Relation Analyzer</title>
<style>
tr.rel_ok {
    background-color: #CCC;
}
tr.rel_not_ok {
    background-color: pink;
}
tr.warning {
    background-color: #F30;
}
tr.possible_ok {
    background-color: lightgreen;
}
tr.possible_not_ok {
    background-color: pink;
}
tr.possible_add {
    background-color: yellow;
}
</style>
</head>\n<body>\n";
analyze_relations();
analyze_ways();
print "</body>\n</html>";

sub prepare_relations {
    my $obj = shift;

    for my $member(@{$obj->{members}}) {
        if ($member->{type} eq 'way') {
            push @{$wayid2relid{$member->{ref}}}, $obj->{id};
            push @{$relid2wayid{$obj->{id}}}, $member->{ref};
        }
    }

    my %copy = %$obj;
    $rel{$obj->{id}} = \%copy;
}
sub prepare_ways {
    my $obj = shift;

    my %copy = %$obj;
    $ways{$obj->{id}} = \%copy;
}
sub analyze_relations {
    print "<h2>Existing relations</h2>\n<table border='1' cellspacing='0' cellpadding='3'>\n";
    my $tr_class;
    my ($total_rel, $total_ways);
    for my $relid(sort {unify_name($rel{$a}->{tag}->{name}) cmp unify_name($rel{$b}->{tag}->{name})} keys %relid2wayid) {
        $relnames{unify_name($rel{$relid}->{tag}->{name})} = 0;
        $total_rel++;
        #print STDERR "[!] will check connectivity for $relid\n";
        my @comp = @{get_connectivity($relid2wayid{$relid})};
        if (scalar @comp == 1) {
            $tr_class = 'rel_ok';
        } else {
            $tr_class = 'rel_not_ok';
        }
        printf "<tr class='$tr_class'><td>%d [<a href='%s'>j</a>]</td><td>%s</td><td><a href='%s'>%s</a></td><td>%d / %d</td></tr>\n",
            $relid, get_josm_remote_link($relid, 'relation'), $rel{$relid}->{tag}->{type}, get_osm_link($relid, 'relation'), $rel{$relid}->{tag}->{name}, scalar @comp, total_in_cluster(\@comp);
        #print dump($rel{$relid})."\n";
        for my $wayid(@{$relid2wayid{$relid}}) {
            if ($ways{$wayid}) {
                $total_ways++;
                for my $tag(keys %tags_to_match) {
                    if ($rel{$relid}->{tag}->{$tag} ne $ways{$wayid}->{tag}->{$tag}) {
                        printf "<tr class='warning'><td colspan='4'>%s mismatch: relation %d (%s) and way %d (%s)</td></tr>\n",
                            $tag, $relid, $rel{$relid}->{tag}->{$tag}, $wayid, $ways{$wayid}->{tag}->{$tag};
                    }
                }
                if (scalar @{$wayid2relid{$wayid}} > 1) {
                    printf "<tr class='warning'><td colspan='4'>way %d is included in more than one relation (%s)</td></tr>\n",
                        $wayid, join(', ', @{$wayid2relid{$wayid}});
                }
            }
        }
    }
    print "</table>\n"; 
    printf "<p>Total %d existing relations containing %d ways</p>",
        $total_rel, $total_ways;
}
sub analyze_ways {
    print "<h2>Possible relations</h2>\n<table border='1' cellspacing='0' cellpadding='3'>\n";
    
    my ($total_rel, $total_ways);
    
    my $name_string = undef;
    my $tr_class;
    
    for my $wayid(keys %ways) {
        next if exists $wayid2relid{$wayid};
        $name_string = unify_name($ways{$wayid}->{tag}->{name});
        push @{$name2wayid{$name_string}}, $wayid;
    }

    my %clusters = %{process_connectivity(\%name2wayid)};

    for my $name(sort {total_in_cluster($clusters{$b}) <=> total_in_cluster($clusters{$a})} keys %clusters) {
        next if total_in_cluster($clusters{$name}) < 2 && !exists $relnames{unify_name($name)};
        $total_rel++;
        $total_ways += total_in_cluster($clusters{$name});
        if (exists $relnames{unify_name($name)}) {
            $tr_class = 'possible_add';
        }
        elsif (scalar @{$clusters{$name}} == 1) {
            $tr_class = 'possible_ok';
        } else {
            $tr_class = 'possible_not_ok';
        }
        printf "<tr class='$tr_class'><td>%s</td><td>%d / %d</td></tr>\n",
            $name, scalar @{$clusters{$name}}, total_in_cluster($clusters{$name});
    }
    
    print "</table>";
    printf "<p>Total %d possible relations containing %d ways</p>",
        $total_rel, $total_ways;
}
sub unify_name {
    my $str = shift;
    $str =~ tr/[А-ЯЁ]/[а-яё]/;
    $str =~ s/\b(ул\.|ул$)/улица/;
    $str =~ s/\b(ш\.|ш$)/шоссе/;
    $str =~ s/\b(пер\.|пер$)/переулок/;
    $str =~ s/\b(пр\.|пр$)/проспект/;
    $str =~ s/\b(пл\.|пл$)/площадь/;
    $str =~ s/\b(наб\.|наб$)/набережная/;
    $str =~ s/\b(дор\.|дор$)/дорога/;
    $str =~ s/\b(бул\.|бул$)/бульвар/;
    $str =~ s/ё/е/g;

    $str =~ s/^(улица|проспект|переулок|площадь|шоссе|набережная|дорога|бульвар|аллея|мост|тупик)\s+(.+)/$2 $1/;
    return $str;
}
sub process_connectivity {
    my %name2wayid = %{shift()};
    my %clusters;

    my @keys;

    for my $name(keys %name2wayid) {
        #print STDERR "name is $name\n";
        @keys = @{$name2wayid{$name}};
        my @comp = @{get_connectivity(\@keys)};
        $clusters{$name} = \@comp;
    }

    return \%clusters;
}
sub get_connectivity {
    #print STDERR "get connectivity called\n";
    #returns reference to AoA
    my @ways = @{shift()};
    my @comp;

    my %wayhash = ();
    for my $w(@ways) {
        next unless exists $ways{$w};
        $wayhash{$w} = 0;
    }
    #print STDERR "initial wayhash is ".dump(%wayhash)."\n";

    #making the first component consisting of the first way
    push @comp, [$ways[0]];
    delete $wayhash{$ways[0]};
    #print STDERR "\@comp is ".dump(@comp)."\n";
    #print STDERR "\%wayhash is ".dump(%wayhash)."\n";

    my $change = 1;
    W:while($change) {
        $change = 0;
        for my $i(0..$#comp) {
            #print STDERR "checking component $i\n";
            my @set = @{$comp[$i]};
            for my $way(keys %wayhash) {
                #print STDERR "way $way\n";
                for my $setway(@set) {
                    if (have_common_node($way, $setway)) {
                        #print STDERR "  ok $way with $setway!\n";
                        push @{$comp[$i]}, $way;
                        delete $wayhash{$way};
                        #print STDERR "deleted wayhash{$way}\n";
                        $change = 1;
                        next W;
                    }
                }
            }
        }
        #printf STDERR "currently %d components, %d ways remaining\n",
            #scalar @comp, scalar keys %wayhash;
            #exit if scalar @comp > 9;
        if (scalar keys %wayhash > 0) {
            my ($k, $v) = each %wayhash;
            #print STDERR "still have ways, new component is [$k]\n";
            push @comp, [$k];
            delete $wayhash{$k};
            $change = 1;
        }
    }

    return \@comp;
}
sub have_common_node {
    my ($wayid1, $wayid2) = @_;
    my $way1 = $ways{$wayid1};
    my $way2 = $ways{$wayid2};
    for my $node1(@{$way1->{chain}}) {
        for my $node2(@{$way2->{chain}}) {
            return 1 if $node1 == $node2;
        }
    }
    return 0;
}
sub total_in_cluster {
    my @comp = @{shift()};
    my $sum;
    for my $c(@comp) {
        $sum += scalar @$c;
    }
    return $sum;
}
sub get_josm_remote_link {
    my ($obj_id, $obj_type) = @_;
    return sprintf "http://localhost:8111/import?url=http://api.openstreetmap.org/api/0.6/%s/%d", $obj_type, $obj_id;
}
sub get_osm_link {
    my ($obj_id, $obj_type) = @_;
    return sprintf "http://openstreetmap.org/browse/%s/%d", $obj_type, $obj_id;
}
